Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PBLIB1/UNITS/OBJHOLD.INC

Text File | 1994-04-30 | 6KB | 243 lines

{SECTION HOLD_object }
CONSTRUCTOR HOLD_object.init(n : HOLD_NdxType);
var l : longint;
    i : HOLD_NdxType;
     begin
     MaxEntries := n;
     ArrHighVal := 0;
     comment := '';
     STRA_object.init(n);
     l := sizeof(HOLD_NumType) * n;
     if memavail > l then
          begin
          getmem(ArrNum,l);
          for i := 1 to arraymax do ArrNum^[i] := 0;
          end;
     end;


Procedure HOLD_object.done;
var l : longint;
     begin
     ArrHighVal := 0;
     l := sizeof(HOLD_NumType) * arraymax;
     IF (ArrNum <> NIL) and (l > 0) then
          begin
          FreeMem (ArrNum,l);
          ArrNum := NIL;
          end;
     STRA_object.done;
     end;



Function  HOLD_object.HighNum  : HOLD_NumType;
     begin
     HighNum := ArrHighVal;
     end;


Function  HOLD_object.findstr(st : string) : HOLD_NdxType;
var i,j  : HOLD_NdxType;
     begin
     j := 0;
     i := STRA_object.find(st);
     if i > 0 then j := i;
     findstr := j;
     end;


Function  HOLD_object.findnum(Num : HOLD_NumType) : HOLD_NdxType;
var i,j  : HOLD_NdxType;
    alldone : boolean;
     begin
     j := 0;
     alldone := false;
     if Num <= ArrHighVal then
          begin
          i := 0;
          while (i < ArrayUsed) and not alldone do
               begin
               inc(i);
               if ArrNum^[i] = Num then
                    begin
                    j := i;
                    alldone := true;
                    end;
               end;
          end;
     findnum := j;
     end;


Function  HOLD_object.count : HOLD_NdxType;
     begin
     count := ArrayUsed;
     end;



Function  HOLD_object.fetchNumN (n : HOLD_NdxType) : HOLD_NumType;
     begin
     if (n > 0) and (n <= ArrayUsed) then
          fetchNumN := ArrNum^[n]
     else fetchNumN := 0;
     end;


Function  HOLD_object.fetchStrN (n : HOLD_NdxType) : string;
     begin
     fetchStrN := STRA_object.fetchstring(n);
     end;


Function HOLD_object.fetchN(n : HOLD_NdxType;var st :string; var Num :HOLD_NumType):boolean;
var ok : boolean;
     begin
     ok := true;
     if n > arrayused then ok := false;
     Num := fetchNumN(n);
     st := fetchStrN(n);
     fetchN := ok;
     end;


Function HOLD_object.append(st : string; Num : HOLD_NumType) : boolean;
var OK : boolean;
     begin
     OK := STRA_object.append(st);
     if OK then ArrNum^[ArrayUsed] := Num;
     if Num > ArrHighVal then ArrHighVal := Num;
     append := OK;
     end;


Function HOLD_object.storeN (n : HOLD_NdxType; st : string; Num : HOLD_NumType): Boolean;
var OK : boolean;
     begin
     OK := STRA_object.storeN(n,st);
     if OK then ArrNum^[n] := Num;
     if Num > ArrHighVal then ArrHighVal := Num;
     storeN := OK;
     end;


{$R-}

Procedure HOLD_object.swap(i,j : HOLD_NdxType);
var sptr  : stringptr;
    Num   : HOLD_NumType;
     begin
     STRA_object.swap(i,j);
     Num   := ArrNum^[i];
     ArrNum^[i] := ArrNum^[j];
     ArrNum^[j] := Num;
     end;


procedure HOLD_object.sort;    {sorts based on string value }
var Gap,I,J,N  : HOLD_NdxType;
    s1,s2      : stringptr;
     begin
     if arraysorted then exit;
     N   := STRA_object.count;
     Gap := N div 2;
     while (Gap > 0) do
         begin
         I := Gap;
         while (I < N) do
              begin
              J := I - Gap;
              s1 := arrayptr^[J+Gap+1].strptr;
              s2 := arrayptr^[J+1].strptr;
              while (J >= 0) and (s1^ < s2^) do
                   begin
                   HOLD_object.swap(J+1,J+Gap+1);
                   dec(J,Gap);
                   s1 := arrayptr^[J+Gap+1].strptr;
                   s2 := arrayptr^[J+1].strptr;
                   end;
              inc(I);
              end;
         Gap:=Gap div 2;
         end;
     arraysorted := true;
     end;

{$R+}




Procedure HOLD_object.dumpN(n : HOLD_NdxType);
var i  : HOLD_NdxType;
     begin
     if ArrayUsed < 1 then exit;
     if n > ArrayUsed then n := arrayused;
     writeln('dump   used: ',arrayused,'   max: ',ArrHighVal);
     for i := 1 to n do
          begin
          writeln(i:4,'  str [',arrayptr^[i].fetch,']  num [ ',
                  ArrNum^[i]:5,' ]');
          end;
     end;


Procedure HOLD_object.dump;
var i  : HOLD_NdxType;
     begin
     dumpN(9999);
     end;



Procedure HOLD_object.save(fname : string);
var i   : HOLD_NdxType;
    ok  : boolean;
    s   : string;
    tx  : TFILE_object;
     begin
     if arrayused < 1 then exit;
     tx.init(fname,true);
     if comment <> '' then
          begin
          s := comment;
          trim(s);
          ok := tx.append('!'+s);
          end;
     for i := 1 to arrayused do
          begin
          s := longintstr(ArrNum^[i],8);
          trim(s);
          ok := tx.append(trimstr(arrayptr^[i].fetch)+','+s);
          end;
     tx.done;
     end;


Procedure HOLD_object.load(fname : string);
var s,st  : string;
    num   : HOLD_NumType;
    ok    : boolean;
    tx    : TFILE_object;
     begin
     comment := '';
     tx.init(fname,false);
     num  := 0;
     while tx.fetchnext(s) do
          begin
          if (num=0) and (s[1]='!') then
               begin
               delete(s,1,1);
               comment := s;
               end
          else begin
               st  := GetString(s);
               num := strlong(GetString(s));
               ok  := HOLD_object.append(st,num);
               end;
          end;
     tx.done;
     end;